home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / t_os / ashula / casting.bas < prev    next >
BASIC Source File  |  1991-10-18  |  39KB  |  613 lines
  1. 1 'save "h:\casting.bas"
  2. 5 'CASTING-BORD Ver. 0.5 for ASHULA Ver. 0.87
  3. 7 KEY 1,CHR$(29,5)+"save"+CHR$(34)+"h:\cast":KEY 2,"ing.bas"+CHR$(13)
  4. 10 CLEAR ,,1024,1024288,10000:DEFINT A-Z:LOADM ".\wrbox.rex",0:LOADM ".\SPREAD.REX",4096:SCREEN@ 0
  5. 20 DEFINT A-Z:DIM MM$(10,10),MM%(11,2),MSG&(6720),DIALOG&(6720),CAST%(26,32,3),CASTS&(26,3),PAL&(255),G&(19199),G2&(19199), BUF%(511,7),G%(1535),GM%(1535),GP%(1023,3):COLOR 7,0:CLS:CONSOLE 0,1
  6. 25 DEF FNF(N,FAD&)=PEEK(FAD&,N):DEF FNCV(FAD&)=PEEK(FAD&,1)*256+PEEK(FAD&+1,1)
  7. 30 DEF FNN$(NUM)=RIGHT$(STR$(NUM),LEN(STR$(NUM))-1):DEF FNB!(M$)=CVL(RIGHT$(M$,1)+MID$(M$,3,1)+MID$(M$,2,1)+LEFT$(M$,1)):DEF FNO$(A%)=CHR$(A% MOD 256,A% \ 256):DEF FNO(A$)=ASC(LEFT$(A$,1))+ASC(RIGHT$(A$,1))*256
  8. 40 :GOSUB *GSCREENON:RESTORE 8000:READ MNM,MIC,PDC,CPDC
  9. 50 FOR A=0 TO MNM-1:READ MM%(A,0):FOR B=0 TO MM%(A,0):READ MM$(A,B):NEXT:NEXT:B=0:FOR A=0 TO MNM-1:MM%(A,1)=B:B=B+LEN(MM$(A,0))+1:NEXT:MM%(A,1)=B:COLOR MIC:FOR A=0 TO MNM-1:LOCATE MM%(A,1),0:PRINT MM$(A,0);:NEXT:COLOR 7
  10. 60 FOR A=0 TO MNM-1:B=0:FOR C=1 TO MM%(A,0):IF LEN(MM$(A,C))>B THEN B=LEN(MM$(A,C))
  11. 70 NEXT:MM%(A,2)=B:NEXT:GOSUB *MENUWRITE
  12. 80 D$="H:":FILE$="\GDATA":TAIL1$=".TIF":TAIL2$=".PGF":TAIL3$=".GFD":IDV$="GFD."+CHR$(1):OFM=0:LINKF=0:LIF$="":FMF=0
  13. 90 SCM=0:MBX0=0:MBY0=0:MBX1=0:MBY1=0:M$="":CHF=0:NOF=0:BSIZE=0:BIT=4:GOSUB *SCM0
  14. 495 GOSUB *GSCREENOFF:GOSUB *GSCREENON
  15. 500 *IVENTLOOP:COLOR ,,,4:GOSUB *MENU:COLOR ,,,0:' PRINT CMD0,CMD1,CMD$
  16. 510 IF CMD$=" 終了" THEN GOSUB *END:GOTO *IVENTLOOP
  17. 520 IF CMD0=0 AND CMD1=1 THEN GOSUB *ABOUT:GOTO *IVENTLOOP
  18. 530 ON CMD0 GOTO *FILE,*EDIT,*DISPLAY,*CAST,*FRAME:GOTO *IVENTLOOP
  19. 600 *FILE:ON CMD1 GOSUB *OPEN,*SAVE,*SETLINK,*END:GOTO *IVENTLOOP
  20. 700 *EDIT:ON CMD1 GOSUB *UNDO,*CUT,*COPY,*PASTE,*CLEAR:GOTO *IVENTLOOP
  21. 800 *DISPLAY:ON CMD1 GOSUB *DEFFRAME,*DATASIZE:GOTO *IVENTLOOP
  22. 900 *CAST:ON CMD1 GOSUB *NEWCAST,*DELETECAST,*CASTXCHANGE:GOTO *IVENTLOOP
  23. 1000 *FRAME:ON CMD1 GOSUB *GENFRAME,*DELETEFRAME,*FRAMEOPERATION,*FRAMEEDIT:GOTO *IVENTLOOP
  24. 2000 *OPEN:GOSUB *GSCREENOFF
  25. 2130 PBX0=0:PBY0=160:PBX1=639:PBY1=329:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  26. 2140 LOCATE 2,9:PRINT "書類を開きます｡";:GOSUB *OPENMODE:LOCATE 50,16:PRINT "[取 消]";:LOCATE 60,16:PRINT "[実 行]";:GOSUB *FILEPRINT
  27. 2150 GOSUB *MOUSEGETCSK:IF YN<>2 THEN 2500
  28. 2160 IF MMY<304 OR MMY>322 THEN 2180 ELSE IF MMX>399 AND MMX<456 THEN YN=0:GOTO 2500
  29. 2170 IF MMX>479 AND MMX<536 THEN YN=1:GOTO 2500 ELSE 2150
  30. 2180 GOSUB *AREACHECK:IF ER=1 THEN BEEP:GOTO 2150
  31. 2190 IF MMY>208 AND MMY<228 THEN IF MMX<80 OR MMX>511 THEN 2150 ELSE OFM=MMX \ 320:GOSUB *OPENMODE:GOTO 2150
  32. 2200 IF MMY<266 OR MMY>284 THEN 2150
  33. 2210 IF MMX>16 THEN IF MMX<24 THEN 2150 ELSE 2300
  34. 2220 LOCATE 0,18:COLOR 7:FOR A=0 TO 25:PRINT CHR$(65+A)+": ";:NEXT:CALLM 0,1,0,&H77,0,340,639,362,3:LOCATE (ASC(D$)-65)*3,18:PRINT D$;
  35. 2230 M$="ファイルが格納されているドライブ名を左クリックで指定してください｡":GOSUB *MESSAGE
  36. 2240 GOSUB *MOUSEGETCSK:IF YN=0 THEN 2240
  37. 2250 IF YN=2 THEN IF MMY<340 OR MMY>362 THEN BEEP:GOTO 2240
  38. 2260 IF YN=2 THEN IF MMX>383 OR (MMX MOD 24)>16 THEN 2240
  39. 2270 LOCATE 0,18:PRINT STRING$(80," ");:LOCATE 0,24:PRINT STRING$(79," ");:CALLM 0,1,0,0,0,340,639,479,0
  40. 2280 IF YN=1 THEN 2150
  41. 2290 D$=CHR$((MMX \ 24)+65)+":":GOSUB *FILEPRINT:GOTO 2150
  42. 2300 GOSUB *FILEIN:GOSUB *FILEPRINT:GOTO 2150
  43. 2400 *FILEIN
  44. 2410 CALLM 0,1,0,&HFF,0,340,639,341,0:CALLM 0,1,0,&HFF,0,380,639,381,0:LOCATE 0,18:PRINT FILE$;:M$="ファイル名をキーボードから入力してください｡":GOSUB *MESSAGE
  45. 2420 I$="":WHILE I$<>CHR$(13):STL=LEN(FILE$):MMX=(STL MOD 80)*8:MMY=((STL \ 80)+18)*19:I$="":WHILE I$="":CALLM 0,1,0,&HFF,MMX,MMY,MMX+7,MMY+18,3:FOR A=0 TO 100:NEXT:CALLM 0,1,0,&HFF,MMX,MMY,MMX+7,MMY+18,3:FOR A=0 TO 100:NEXT:I$=INKEY$:WEND
  46. 2430 I=ASC(I$):IF I=8 OR I=29 THEN STL=STL-1:IF STL<0 THEN STL=0
  47. 2440 IF I>96 AND I<&H123 THEN I=I-32:I$=CHR$(I)
  48. 2450 IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ\0123456789$&#%'@^{}`!_",I$)<>0 THEN FILE$=FILE$+I$:STL=STL+1
  49. 2460 FILE$=LEFT$(FILE$,STL):LOCATE 0,18:PRINT LEFT$(FILE$+STRING$(160," "),160);
  50. 2470 WEND:LOCATE 0,18:PRINT STRING$(160," ");:LOCATE 0,24:PRINT STRING$(79," ");:CALLM 0,1,0,0,0,340,639,479,0:RETURN
  51. 2500 IF YN=0 THEN CLS 3:GOSUB *GSCREENON:RETURN
  52. 2510 IF OFM=1 THEN T$=TAIL1$:GOSUB 2520:GOTO 2600
  53. 2520 ON ERROR GOTO 2580:OPEN "I",#1,D$+FILE$+T$:ON ERROR GOTO 0:DUM$=INPUT$(4,1):IF DUM$="YUKI" THEN *PXX ELSE IF DUM$="PMGf" THEN *PMGFLOAD
  54. 2525 DUM$=INPUT$(26,1):A!=FNB!(INPUT$(4,1)):X=A!:DUM$=INPUT$(8,1):A!=FNB!(INPUT$(4,1)):Y=A!:DUM$=INPUT$(8,1):A!=FNB!(INPUT$(4,1)):BIT=A!
  55. 2530 CLOSE #1:IF BIT=4 THEN GOSUB *SCM0 ELSE IF BIT=16 THEN GOSUB *SCM1 ELSE M$="指定のTIFFファイルは256色ファイルです｡":GOSUB *ALART:GOSUB *MOUSEWAIT:ON ERROR GOTO 0:GOTO 2150
  56. 2540 CLS 5:LOAD@ D$+FILE$+T$,(0,0):ON ERROR GOTO 0:GOSUB *PALCHK:FOR A=0 TO 25:FOR B=0 TO 3:CASTS&(A,B)=0:NEXT:FOR B=0 TO 31:FOR C=0 TO 3:CAST%(A,B,C)=0:NEXT:NEXT:NEXT:LINKF=0:LIF$="":FMF=0
  57. 2550 CLS 4:GOSUB *GSCREENON:GOSUB *MENUWRITE:RETURN
  58. 2580 IF T$=".PGF" THEN T$=".TIF":RESUME
  59. 2582 IF T$=".TIF" THEN T$=".P16":RESUME
  60. 2584 IF T$=".P16" THEN T$=".P32":RESUME ELSE GOSUB *MOUSEINIT
  61. 2590 M$="存在しないファイル､パス名が指定されたか､入力中にエラーが発生しました｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 2550
  62. 2600 ON ERROR GOTO 2590:OPEN "I",#1,D$+FILE$+TAIL3$
  63. 2610 IF INPUT$(5,1)<>IDV$ THEN M$="指定されたファイルは非フレーム設定ファイルか､未サポートのバージョンです｡":CLOSE:GOSUB *ALART:GOSUB *MOUSEWAIT:GOTO 2550
  64. 2620 DUM$=INPUT$(1,1):TUF=FNO(INPUT$(2,1))
  65. 2630 FOR A=0 TO TUF-1:CAS=ASC(INPUT$(1,1)):FRA=ASC(INPUT$(1,1)):CASTS&(CAS,0)=CASTS&(CAS,0)+1:FOR B=0 TO 3:CAST%(CAS,FRA,B)=FNO(INPUT$(2,1)):NEXT:NEXT
  66. 2640 FMF=0:IF INPUT$(2,1)<>"@L" THEN CLOSE:LINKF=0:LIF$="" ELSE LINKF=1:DUM=ASC(INPUT$(1,1)):LIF$=INPUT$(DUM-1,1) 
  67. 2650 FOR A=0 TO 25
  68. 2660   IF CASTS&(A,0)<>0 THEN MRX=CAST%(A,0,2)-CAST%(A,0,0)+1:MRY=CAST%(A,0,3)-CAST%(A,0,1)+1:CAS=A:GOSUB *GETDATASIZE:CASTS&(A,2)=MRX:CASTS&(A,3)=MRY
  69. 2670 NEXT
  70. 2680 PLAY "@74T120V8L8O5C":RETURN
  71. 2700 *OPENMODE
  72. 2710 IF OFM=0 THEN M$=" ● 画像ファイルのみ":M1$=" ○ フレーム設定ファイル込み":T$=TAIL2$
  73. 2720 IF OFM=1 THEN M$=" ○ 画像ファイルのみ":M1$=" ● フレーム設定ファイル込み":T$=TAIL3$
  74. 2730 LOCATE 10,11:PRINT M$;:LOCATE 40,11:PRINT M1$;:GOSUB *FILEPRINT:RETURN
  75. 2750 *FILEPRINT
  76. 2760 LOCATE 0,14:PRINT D$;:LOCATE 3,14:PRINT LEFT$(FILE$+T$+STRING$(80," "),77);:RETURN
  77. 2800 *PALCHK
  78. 2810 IF SCM=0 THEN DL=15 ELSE RETURN
  79. 2820 ON ERROR GOTO *ERROR:OPEN "I",#1,D$+FILE$+".plt":ON ERROR GOTO 0
  80. 2830 A!=CVL(INPUT$(4,1)):CLOSE #1:IF HEX$(A!)="F0000000" THEN GOSUB *PAL_INI ELSE GOSUB *PAL_LOAD
  81. 2840 GOSUB *PALETTE_CHANGE:RETURN
  82. 2850 *PAL_INI
  83. 2860 IF SCM=1 THEN RETURN ELSE RESTORE 2870:FOR A=0 TO 15:READ PAL&(A):NEXT:FOR A=16 TO 255:PAL&(A)=0:NEXT:A&=16:PALETTE@:RETURN
  84. 2870 DATA 0,128,32768,32896,8388608,8388736,8421376,8421504,4210752,255,65280,65535,16711680,16711935,16776960,16777215
  85. 2880 *PAL_LOAD
  86. 2890 OPEN "I",#1,D$+FILE$+".plt":FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:CLOSE #1:RETURN
  87. 2900 *ERROR:GOSUB *PAL_INI:ON ERROR GOTO 0:RESUME 2840
  88. 2910 *PALETTE_CHANGE
  89. 2920 FOR A=0 TO DL:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
  90. 3000 *SAVE 
  91. 3010 IF FMF=0 THEN GOSUB *SETLINK
  92. 3020 ON ERROR GOTO 3300
  93. 3030 OPEN "O",#1,D$+FILE$+TAIL3$
  94. 3040 ON ERROR GOTO 3330
  95. 3050 PRINT #1,IDV$;          'ファイルID+バージョンナンバー出力
  96. 3060 PRINT #1,CHR$(BIT);    '画像ファイルのビット数出力
  97. 3070 TUF=0:FOR A=0 TO 25:TUF=TUF+CASTS&(A,0):NEXT
  98. 3080 PRINT #1,FNO$(TUF); '総フレーム数出力
  99. 3090 FOR A=0 TO 25           'ここからフレーム設定出力
  100. 3100   IF CASTS&(A,0)=0 THEN 3140
  101. 3110   FOR B=0 TO CASTS&(A,0)-1
  102. 3120     PRINT #1,CHR$(A,B)+FNO$(CAST%(A,B,0))+FNO$(CAST%(A,B,1))+FNO$(CAST%(A,B,2))+FNO$(CAST%(A,B,3));
  103. 3130   NEXT
  104. 3140 NEXT
  105. 3150 IF LINKF=0 THEN PRINT #1,"@E";:CLOSE:PLAY "@74T120V8L8O5C"
  106. 3160 IF LINKF<>0 THEN PRINT #1,"@L"+CHR$(LEN(LIF$)+1)+LIF$+CHR$(0);:CLOSE:PLAY "@74T120V8L8O4C"
  107. 3200 CLS 3:ON ERROR GOTO 0:RETURN
  108. 3300 IF ERR=64 THEN KILL D$+FILE$+TAIL3$:RESUME
  109. 3330 IF ERR=53 THEN CLOSE:M$="入出力装置に以上が発生しました｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  110. 3340 IF ERR=59 THEN CLOSE:M$="使用中の入出力装置はオープンできません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  111. 3350 IF ERR=60 THEN CLOSE:M$="指定の入出力装置は使用できません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  112. 3360 IF ERR=61 THEN CLOSE:M$="入出力バッファがあふれました｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  113. 3370 IF ERR=63 THEN CLOSE:M$="指定のファイルがみつかりません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  114. 3380 IF ERR=65 THEN CLOSE:M$="ディスクのディレクトリ領域に空き領域がありません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  115. 3390 IF ERR=67 THEN CLOSE:M$="ディスクに空き領域がありません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  116. 3400 IF ERR=72 THEN CLOSE:M$="指定されたディスク装置が使用可能な状態になっていません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  117. 3410 IF ERR=73 THEN CLOSE:M$="指定されたディスクは書き込みが禁止されています｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  118. 3420 IF ERR=74 THEN CLOSE:M$="デバイスまたはファイルのアクセスが拒否されました｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  119. 3430 M$="Line-"+FNN$(ERL)+"にエラーコード"+FNN$(ERR)+"のエラーが発生しました｡":GOSUB *ALART:GOSUB *MOUSEWAIT:RESUME 3200
  120. 3500 *SETLINK
  121. 3510 SWAP FILE$,LIF$:PBX0=0:PBY0=160:PBX1=639:PBY1=329:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  122. 3520 LOCATE 2,9:PRINT "リンクファイルの設定を行います｡";:GOSUB *LINKMODE:LOCATE 60,16:PRINT "[実 行]";:GOSUB *LINKPRINT:GOSUB *GSCREENOFF
  123. 3530 GOSUB *MOUSEGETCSK:IF YN=0 THEN 3530 ELSE IF YN=1 THEN 3600
  124. 3540 IF MMX>479 AND MMX<536 AND MMY>303 AND MMY<323 THEN 3600
  125. 3550 GOSUB *AREACHECK:IF ER=1 THEN BEEP:GOTO 3530
  126. 3560 IF MMY>208 AND MMY<228 THEN IF MMX>79 AND MMX<208 THEN LINKF=1-LINKF:GOSUB *LINKMODE:GOTO 3530
  127. 3570 IF MMY<266 OR MMY>284 THEN 3530
  128. 3580 GOSUB *FILEIN:GOSUB *LINKPRINT:GOTO 3530
  129. 3600 CLS 3:GOSUB *GSCREENON:SWAP FILE$,LIF$:FMF=1:RETURN
  130. 3650 *PXX
  131. 3660 CLOSE #1:F_F$=D$+FILE$+T$:GOSUB *FILESIZE:LOAD@ D$+FILE$+T$,FILBUF%:ON ERROR GOTO 0
  132. 3670 IF FILBUF%(9)<>3 THEN M$="指定のファイルは16色ファイルではありません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:GOTO 2150
  133. 3680 PAL&=VARPTR(FILBUF%(12)):FOR A=0 TO 15:PALETTE A,[PEEK(PAL&+A*6+3),PEEK(PAL&+A*6+1),PEEK(PAL&+A*6+5)]:NEXT:CLS 5:PUT@A (FILBUF%(63),FILBUF%(64))-(FILBUF%(65),FILBUF%(66)),FILBUF%,PSET,,,,67:ERASE FILBUF%
  134. 3690 FOR A=0 TO 25:FOR B=0 TO 3:CASTS&(A,B)=0:NEXT:FOR B=0 TO 31:FOR C=0 TO 3:CAST%(A,B,C)=0:NEXT:NEXT:NEXT:LINKF=0:LIF$="":FMF=0:CLS 4:GOSUB *GSCREENON:GOSUB *MENUWRITE:RETURN
  135. 3700 *FILESIZE
  136. 3710  F_1 =INSTR (F_F$,":")
  137. 3720  F_D$=LEFT$ (F_F$,F_1)
  138. 3730  F_F$=RIGHT$(F_F$,LEN(F_F$)-LEN(F_D$))
  139. 3740  OPEN "R",#3,F_D$+"(1)"+F_F$
  140. 3750  F_SI&=LOF(3)
  141. 3760  CLOSE #3
  142. 3770 DIM FILBUF%(CLNG(F_SI&/2+.5!)-2)
  143. 3780 RETURN
  144. 3900 *LINKMODE
  145. 3910 IF LINKF=0 THEN M$=" ○ リンクモード"
  146. 3920 IF LINKF=1 THEN M$=" ● リンクモード"
  147. 3930 LOCATE 10,11:PRINT M$;:RETURN
  148. 3950 *LINKPRINT
  149. 3960 LOCATE 0,14:PRINT LEFT$(FILE$+STRING$(80," "),80);:RETURN
  150. 4500 *UNDO
  151. 4510 GOSUB *DISABLE:RETURN
  152. 4520 *CUT
  153. 4530 GOSUB *DISABLE:RETURN
  154. 4540 *COPY
  155. 4550 GOSUB *DISABLE:RETURN
  156. 4560 *PASTE
  157. 4570 GOSUB *DISABLE:RETURN
  158. 4580 *CLEAR
  159. 4590 GOSUB *DISABLE:RETURN
  160. 4900 *END
  161. 4999 END
  162. 5000 *MSGBOX
  163. 5010   IF SCM=0 THEN MBX0=0:MBY0=396:MBX1=639:MBY1=479 ELSE MBX0=0:MBY0=198:MBX1=319:MBY1=239
  164. 5020   GET@A (MBX0,MBY0)-(MBX1,MBY1),MSG&
  165. 5030   LINE (MBX0,MBY0)-(MBX1,MBY1),PSET,0,BF:LINE (MBX0,MBY0)-(MBX1,MBY0),PSET,4:LINE (MBX0,MBY1)-(MBX1,MBY1),PSET,4
  166. 5040 RETURN
  167. 5100 *MSGOFF
  168. 5110   IF SCM=0 THEN MBX0=0:MBY0=396:MBX1=639:MBY1=479 ELSE MBX0=0:MBY0=198:MBX1=319:MBY1=239
  169. 5120   CLS 4
  170. 5130   PUT@A (MBX0,MBY0)-(MBX1,MBY1),MSG&
  171. 5140 RETURN
  172. 5200 *SCM0
  173. 5210 SCM=0:SCREEN@ 0:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):GOSUB *MOUSEINIT:RETURN
  174. 5250 *SCM1
  175. 5260 SCM=1:SCREEN@ 1:WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255):GOSUB *MOUSEINIT:RETURN
  176. 8000 DATA 6 ,7,14,12
  177. 8010 DATA 1,"♪","CastingBoardについて.."
  178. 8020 DATA 4,"ファイル"," 読み込む.."," 保存"," リンク設定.."," 終了"
  179. 8030 DATA 5,"編集"," 取消"," カット"," コピー"," ペースト"," クリア"
  180. 8040 DATA 2,"表示"," 定義済フレーム"," データサイズ.."
  181. 8050 DATA 3,"キャスト"," 新規キャスト.."," キャスト削除.."," キャスト入替.."
  182. 8060 DATA 4,"フレーム"," フレーム作成.."," フレーム削除.."," フレーム順番操作.."," フレーム位置修正.."
  183. 8070 DATA 10,"menu 6","72","72","73","74","75","76","77","78","79","70"
  184. 8080 DATA 10,"menu 7","81","82","83","84","85","86","87","88","89","80"
  185. 8090 DATA 10,"menu 8","91","92","93","94","95","96","97","98","99","90"
  186. 8100 DATA 10,"menu 9","a1","a2","a3","a4","a5","a6","a7","a8","a9","a0"
  187. 8110 DATA 10,"menu10","b1","b2","b3","b4","b5","b6","b7","b8","b9","b0"
  188. 8500 *MENU
  189. 8510 GOSUB *MOUSEINIT:I$=INKEY$:WHILE I$<>"":I$=INKEY$:WEND
  190. 8520 IF MOUSE(2,0)=0 THEN 8520 ELSE A=MOUSE(6,0):MMX=MOUSE(0)*(SCM+1)
  191. 8530 MMY=MOUSE(1)*(SCM+1):IF MMY>18 THEN 8520
  192. 8540 CMD0=-1:MMX=MMX \ 8:FOR A=1 TO MNM:IF MMX<MM%(A,1) THEN CMD0=A-1:A=MNM+1
  193. 8550 NEXT:IF CMD0=-1 THEN 8520 ELSE COLOR PDC:FOR A=1 TO MM%(CMD0,0):LOCATE MM%(CMD0,1),A:PRINT LEFT$(MM$(CMD0,A)+STRING$(32," "),MM%(CMD0,2));:NEXT:OCMD=0:CMD1=0:COLOR 7
  194. 8560 MMX=MOUSE(0)*(SCM+1):MMY=MOUSE(1)*(SCM+1):IF MMX<MM%(CMD0,1)*8 OR (MMX>=(MM%(CMD0,1)+MM%(CMD0,2))*8 AND MMY>18) OR (MMX>=MM%(CMD0+1,1)*8 AND MMY<19) THEN COLOR 7:CLS 3:GOTO 8520
  195. 8570 IF MMY<19 AND OCMD<>0 THEN COLOR CPDC:LOCATE MM%(CMD0,1),OCMD:PRINT MM$(CMD0,OCMD);:CMD1=0:GOTO 8560 ELSE IF MMY<19 OR (MMY \ 19)>MM%(CMD0,0) THEN IF MOUSE(6,0)<>0 THEN COLOR 7:CLS 3:GOTO 8520 ELSE CMD1=0:GOTO 8560
  196. 8580 OCMD=CMD1:CMD1=MMY \ 19:IF OCMD=CMD1 THEN 8600 ELSE IF OCMD<>0 THEN COLOR PDC:LOCATE MM%(CMD0,1),OCMD:PRINT LEFT$(MM$(CMD0,OCMD)+STRING$(32," "),MM%(CMD0,2));
  197. 8590 COLOR CPDC:LOCATE MM%(CMD0,1),CMD1:PRINT LEFT$(MM$(CMD0,CMD1)+STRING$(32," "),MM%(CMD0,2));:COLOR 7
  198. 8600 IF MOUSE(6,0)=0 THEN 8560 ELSE FOR A=0 TO 3:COLOR CPDC:LOCATE MM%(CMD0,1),CMD1:PRINT LEFT$(MM$(CMD0,CMD1)+STRING$(32," "),MM%(CMD0,2));:COLOR PDC:FOR B=0 TO 500:NEXT
  199. 8610 LOCATE MM%(CMD0,1),CMD1:PRINT LEFT$(MM$(CMD0,CMD1)+STRING$(32," "),MM%(CMD0,2));:FOR B=0 TO 500:NEXT:NEXT:COLOR 7:CLS 3:CMD$=MM$(CMD0,CMD1):RETURN
  200. 8620  'writeboxの書式 CALLM 0,LAYER,ScreenMode,PatternByte,X0,Y0,X1,Y1,CMD                                               cmd{ 0:Pset 1:Or 2:And 3:Xor} ScreenModeが3の時は表示レイア指定モードとなる｡(他パラメータは無効) LAYER:レイア0 PatternByte:レイア1
  201. 8700 *MENUWRITE
  202. 8710 COLOR MIC,,,4:FOR A=0 TO MNM-1:LOCATE MM%(A,1),0:PRINT MM$(A,0);:NEXT:COLOR 7,,,0:CALLM 0,1,0,&H77,0,0,639,17,3:RETURN
  203. 8720 *GSCREENON
  204. 8730 CALLM 0,1,3,1,0,0,0,0,0:RETURN
  205. 8740 *GSCREENOFF
  206. 8750 CALLM 0,0,3,1,0,0,0,0,0:RETURN
  207. 8760 *WSCREENOFF
  208. 8770 CALLM 0,0,3,0,0,0,0,0,0:RETURN
  209. 8780 *CSCREENOFF
  210. 8790 CALLM 0,1,3,0,0,0,0,0,0:RETURN
  211. 8800 *ITEMON
  212. 8810 MID$(MM$(CMD0,CMD1),1,1)="*":RETURN
  213. 8820 *ITEMOFF
  214. 8830 MID$(MM$(CMD0,CMD1),1,1)=" ":RETURN
  215. 8840 *ITEMTOGGLE
  216. 8850 IF LEFT$(MM$(CMD0,CMD1),1)="*" THEN GOSUB *ITEMOFF ELSE GOSUB *ITEMON
  217. 8860 RETURN
  218. 8870 *ITEMGET
  219. 8880 IF LEFT$(MM$(CMD0,CMD1),1)="*" THEN YN=1 ELSE YN=0
  220. 8890 RETURN
  221. 9000 *MOUSEGETCSK
  222. 9010 MMX=0:MMY=0:CALLM 0,1,0,&HFF,0,0,7,18,3:I$="":WHILE (MOUSE(2,0)=0 AND I$<>CHR$(24) AND I$<>CHR$(13)):I$=INKEY$
  223. 9020 OMMX=MMX:OMMY=MMY:MMX=MOUSE(0) * (SCM+1) \ 8:MMY=MOUSE(1) * (SCM+1) \ 19:IF MMY>24 THEN MMY=24
  224. 9030 MMX=MMX*8:MMY=MMY*19:IF OMMX<>MMX OR OMMY<>MMY THEN CALLM 0,1,0,&HFF,OMMX,OMMY,OMMX+7,OMMY+18,3:CALLM 0,1,0,&HFF,MMX,MMY,MMX+7,MMY+18,3
  225. 9040 WEND:CALLM 0,1,0,&HFF,MMX,MMY,MMX+7,MMY+18,3
  226. 9050 IF I$=CHR$(24) THEN YN=0:RETURN
  227. 9060 IF I$=CHR$(13) THEN YN=1:RETURN
  228. 9070 WHILE MOUSE(6,0)=0:WEND
  229. 9080 YN=2:RETURN
  230. 9100 *MOUSEGETK
  231. 9110 I$="":WHILE (MOUSE(2,0)=0 AND I$<>CHR$(24) AND I$<>CHR$(13)):I$=INKEY$:WEND
  232. 9120 IF I$=CHR$(24) THEN YN=0:RETURN
  233. 9130 IF I$=CHR$(13) THEN YN=1:RETURN
  234. 9140 WHILE MOUSE(6,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1)
  235. 9150 YN=2:RETURN
  236. 10000 *ABOUT
  237. 10010 CY=10:COLOR 7:M$="CastingBoard Version 0.52":GOSUB *CENTPUT
  238. 10020 CY=11:COLOR 7:M$="for ASHULA Ver. 0.87":GOSUB *CENTPUT
  239. 10030 CY=12:COLOR 5:M$="Copyright 1990-(C) Studio Aspergillus balley":GOSUB *CENTPUT
  240. 10040 CY=13:COLOR 6:M$="All Programmed By おくと-OcToh-":GOSUB *CENTPUT
  241. 10050 CY=14:COLOR 4:M$="1990/11/08":GOSUB *CENTPUT
  242. 10070  CALLM 0,1,0,&H88,136,174,511,296,3:CALLM 0,1,0,&H77,136,176,511,294,3
  243. 10090 GOSUB *MOUSEWAIT:CLS 3:RETURN
  244. 10100 *CENTPUT
  245. 10110 ML=LEN(M$):LOCATE 40-(ML\2),CY:PRINT M$;:COLOR 7:RETURN
  246. 10150 *MOUSEWAIT
  247. 10160 WHILE MOUSE(6,0)=0:WEND:RETURN
  248. 10200 *MESSAGE
  249. 10210 PLAY "@15T120V8L8O5C"
  250. 10220 *MESSAGEIN
  251. 10230 COLOR 7:LOCATE 0,24:PRINT M$;:PLAY "@15T120V8L8O5C"
  252. 10240 CALLM 0,1,0,&H88,0,453,639,474,3:CALLM 0,1,0,&H77,0,455,639,472,3
  253. 10250 RETURN
  254. 10300 *ALART
  255. 10310 COLOR 5:LOCATE 0,24:PRINT M$;:BEEP
  256. 10320 CALLM 0,1,0,&H88,0,453,639,474,3:CALLM 0,1,0,&H77,0,455,639,472,3
  257. 10330 RETURN
  258. 10500 *DISABLE
  259. 10510 M$="この機能はまだサポートされていません。":GOSUB *ALART:GOSUB *MOUSEWAIT:CLS 3:RETURN
  260. 11000 *ANSWER
  261. 11010 COLOR 6:LOCATE 0,24:PRINT M$;:PLAY "@57T120V8L8O5C":I$=INKEY$:WHILE I$<>"":I$=INKEY$:WEND
  262. 11020 CALLM 0,1,0,&H88,0,453,639,474,3:CALLM 0,1,0,&H77,0,455,639,472,3
  263. 11030 YNN=INSTR(M$,"[取")+INSTR(M$,"[終")+INSTR(M$,"[戻"):IF YNN=0 THEN YNN=3000 ELSE YNN=YNN*8-7
  264. 11040 YNY=INSTR(M$,"[実"):IF YNY=0 THEN YNY=3000 ELSE YNY=YNY*8-7
  265. 11050 I$="":WHILE (MOUSE(2,0)=0 AND I$<>CHR$(24) AND I$<>CHR$(13)):I$=INKEY$:WEND:MMX=MOUSE(0)*(SCM+1):MMY=MOUSE(1)*(SCM+1):IF I$=CHR$(24) OR I$=CHR$(13) THEN 11090
  266. 11060 WHILE MOUSE(6,0)=0:WEND:IF MMY<453 OR MMY>474 THEN BEEP:GOTO 11050
  267. 11070 IF MMX>YNN AND MMX<YNN+57 THEN I$=CHR$(24):GOTO 11090
  268. 11080 IF MMX>YNY AND MMX<YNY+57 THEN I$=CHR$(13) ELSE 11050
  269. 11090 IF I$=CHR$(24) THEN YN=0 ELSE YN=1
  270. 11100 RETURN
  271. 14000 *DATASIZE
  272. 14010 TOT&=0:COLOR 12:TUC=0:TUF=0:LOCATE 5,3:PRINT "メモリ使用状況:";:COLOR 7
  273. 14020 FOR A=0 TO 25
  274. 14030 TEMP&=0
  275. 14040   TEMP&=CASTS&(A,1)*CASTS&(A,0):IF CASTS&(A,0) THEN TUC=TUC+1:TUF=TUF+CASTS&(A,0)
  276. 14050   TOT&=TOT&+TEMP&
  277. 14060   LOCATE (A MOD 2)*35+8,(A \ 2)+5:PRINT USING "Cast:@ ###### Bytes [#######]";CHR$(A+65);CASTS&(A,1);TEMP&
  278. 14070 NEXT
  279. 14080 LOCATE 40,19:PRINT USING "Total:  ######## Bytes";TOT&;:LOCATE 11,20:PRINT USING "Total Number of Casts : ##   Total Number of Frame : ###";TUC;TUF;
  280. 14090 CALLM 0,1,0,&HFF,32,50,607,398,3
  281. 14100 M$="メインメニューに戻る時はマウスを左クリックしてください｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT:CLS 3:RETURN
  282. 15000 *DEFFRAME
  283. 15010 M$="確認したらマウスを左クリックしてください｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT:GOSUB 15020:CLS 4:GOSUB *MOUSEWAIT:GOSUB 15020:GOSUB *MENUWRITE:RETURN
  284. 15020 GOSUB *ITEMTOGGLE
  285. 15030 FOR A=0 TO 25
  286. 15040   IF CASTS&(A,0)=0 THEN 15080
  287. 15050   FOR B=0 TO CASTS&(A,0)-1
  288. 15060     LINE (CAST%(A,B,0),CAST%(A,B,1))-(CAST%(A,B,2),CAST%(A,B,3)),XOR,7,B
  289. 15070   NEXT
  290. 15080 NEXT
  291. 15090 RETURN
  292. 15100 *MOUSE_LEAVE
  293. 15110 IF I$=CHR$(24) THEN RETURN
  294. 15120 WHILE MOUSE(6,0)=0:WEND:RETURN
  295. 15200 *AREACHECK
  296. 15210 ER=0:IF MMX<PBX0 OR MMX>PBX1 OR MMY<PBY0 OR MMY>PBY1 THEN BEEP:ER=1
  297. 15220 RETURN
  298. 15500 *PATBOX
  299. 15510 FOR PBY=PBY0 TO PBY1 STEP 2
  300. 15520   CALLM 0,1,0,PAT1%,PBX0,PBY,PBX1,PBY,FC%
  301. 15530   CALLM 0,1,0,PAT2%,PBX0,PBY+1,PBX1,PBY+1,FC%
  302. 15540 NEXT
  303. 15550 IF PBY-1=PBY1 THEN CALLM 0,1,0,PAT1%,PBX0,PBY,PBX1,PBY,FC%
  304. 15560 RETURN
  305. 15800 *GETSTEP
  306. 15810 IF SCM=0 THEN XST=8 ELSE XST=2
  307. 15820 RETURN
  308. 15850 *MOUSEINIT
  309. 15860 MOUSE 0:IF SCM=0 THEN MOUSE 1,319,239,1:MOUSE 3,0,4:MOUSE 3,1,4:MOUSE 4,0,0,639,479 ELSE MOUSE 1,159,119,1:MOUSE 3,0,8:MOUSE 3,1,8:MOUSE 4,0,0,319,239
  310. 15870 RETURN
  311. 15900 *PGET
  312. 15910 COLOR 7:WHILE (MOUSE(2,0)=0):LOCATE 0,23:PRINT USING "### ###";MOUSE(0);MOUSE(1);:WEND:END
  313. 15999 'mm%(11,0:アイテム数 1:メニューの表示位置 2:最長アイテム文字数)            cast%(cast,frame No.-1,0:x0 1:y0 2:x1 3:y1)                                casts&(cast,0:定義キャスト数[0なら未定義] 1:DataSize 2:Xdot数 3:Ydot数)
  314. 16000 *GETRECTANGLE
  315. 16010 MRX=8:MRY=8
  316. 16020 *CHANGERECTANGLE:MOUSE 3,0,8:MOUSE 3,1,8
  317. 16030 WHILE MOUSE(2,0)=0:WEND:MRX0=MOUSE(0):MRY0=MOUSE(1):MRX1=MRX0+MRX-1:MRY1=MRY0+MRY-1:MOFS=MRX0 MOD XST:MOFS2=XST-MOFS:LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:IF (MRX1<640/(SCM+1)) AND (MRY1<480/(SCM+1)) THEN MOUSE 1,MRX1,MRY1,0 ELSE MOUSE 1,MRX0,MRY0,0
  318. 16040 WHILE (MOUSE(6,0)=0 AND MOUSE(2,1)=0)
  319. 16050   OMRX=MRX1:OMRY=MRY1:MRX1=MOUSE(0):MRY1=MOUSE(1):IF MRX1<MRX0 THEN MRX1=MRX1-(MRX1 MOD XST)-MOFS2+1 ELSE MRX1=MRX1+1:MRX1=MRX1-(MRX1 MOD XST)+MOFS-1
  320. 16060   IF (OMRX<>MRX1) OR (OMRY<>MRY1) THEN LINE (MRX0,MRY0)-(OMRX,OMRY),XOR,7,B:LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B
  321. 16070 WEND:MOUSE 1,,,1:LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B
  322. 16080 IF MOUSE (2,1) OR MOUSE(6,1) THEN *CHANGERECTANGLE
  323. 16090 IF MRX1<MRX0 THEN SWAP MRX0,MRX1
  324. 16100 IF MRY1<MRY0 THEN SWAP MRY0,MRY1
  325. 16110 MRX=MRX1-MRX0+1:MRY=MRY1-MRY0+1:MOUSE 3,0,(SCM*4+4):MOUSE 3,1,(SCM*4+4)
  326. 16120 IF MRX<XST OR MRY<1 THEN M$="指定した範囲に誤りがあります｡正しい範囲を指定し直してください｡":GOSUB *ALART:GOSUB *MOUSEWAIT:CLS 3:GOTO *GETRECTANGLE
  327. 16130 RETURN
  328. 17000 *DRAGRECTANGLE
  329. 17010 MOUSE 3,0,8:MOUSE 3,1,8:CLS 4
  330. 17020 IF SCM=1 THEN 17060
  331. 17030   MMX=1023-MRX:IF MMX>639 THEN MMX=639
  332. 17040   MMY=511-MRY:IF MMY>479 THEN MMY=479
  333. 17050  GOTO 17080
  334. 17060   MMX=511-MRX:IF MMX>319 THEN MMX=319
  335. 17070   MMY=255-MRY:IF MMY>239 THEN MMY=239
  336. 17080 LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:MOUSE 1,MRX0,MRY0,0:MOUSE 4,0,0,MMX,MMY:MMX=MRX0:MMY=MRY0:WHILE MOUSE(2,0)=0:WEND
  337. 17090 WHILE MOUSE(6,0)=0
  338. 17100   OMMX=MMX:OMMY=MMY
  339. 17110   IF MOUSE(2,1) THEN MMX=MRX0:MMY=MRY0:MOUSE 1,MMX,MMY,0 ELSE MMX=MOUSE(0):MMY=MOUSE(1)
  340. 17120   IF MMX=OMMX AND MMY=OMMY THEN 17140
  341. 17130   LINE (OMMX,OMMY)-(OMMX+MRX-1,OMMY+MRY-1),XOR,7,B:LINE (MMX,MMY)-(MMX+MRX-1,MMY+MRY-1),XOR,7,B
  342. 17140 WEND:MOUSE 1,,,1:MOUSE 3,0,(SCM*4+4):MOUSE 3,1,(SCM*4+4):MOUSE 4,0,0,(639-SCM*320),(479-SCM*240)
  343. 17150 MRX0=MMX:MRY0=MMY:MRX1=MMX+MRX-1:MRY1=MMY+MRY-1
  344. 17160 M$="CAST:"+CHR$(CAS+65)+"-"+FNN$(FRA)+" は現在の位置に設定してよろしいですか?  [取 消]  [実 行]":GOSUB *ANSWER:CLS 4:IF YN=0 THEN LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:GOTO *DRAGRECTANGLE
  345. 17170 RETURN
  346. 17200 *NEWFRAME
  347. 17210 MRX0=CAST%(CAS,FRA,0):MRY0=CAST%(CAS,FRA,1):MRX1=CAST%(CAS,FRA,2):MRY1=CAST%(CAS,FRA,3):CAS$=CHR$(CAS+65,45)+FNN$(FRA):ON MOUSE(4) GOSUB *ANIMETEST:MOUSE(4) ON
  348. 17220 MOUSE 3,0,8:MOUSE 3,1,8:IF MMODE=0 THEN CLS 4 ELSE LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B
  349. 17230 IF SCM=1 THEN 17270
  350. 17240   MMX=1023-MRX:IF MMX>639 THEN MMX=639
  351. 17250   MMY=511-MRY:IF MMY>479 THEN MMY=479
  352. 17260  GOTO 17290
  353. 17270   MMX=511-MRX:IF MMX>319 THEN MMX=319
  354. 17280   MMY=255-MRY:IF MMY>239 THEN MMY=239
  355. 17290 LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:MOUSE 1,MRX0,MRY0,0:MOUSE 4,0,0,MMX,MMY:MMX=MRX0:MMY=MRY0:IF MMODE=0 THEN WHILE MOUSE(2,0)=0:WEND
  356. 17300 WHILE MOUSE(6,0)=0
  357. 17310   OMMX=MMX:OMMY=MMY:MMX=MOUSE(0):MMY=MOUSE(1)
  358. 17320   IF MMX=OMMX AND MMY=OMMY THEN 17370
  359. 17330   LINE (OMMX,OMMY)-(OMMX+MRX-1,OMMY+MRY-1),XOR,7,B:LINE (MMX,MMY)-(MMX+MRX-1,MMY+MRY-1),XOR,7,B:OLX=LX:OLY=LY:LX=MMX*(SCM+1)\8:LY=MMY*(SCM+1)\19
  360. 17340   IF LX>74 THEN LX=74
  361. 17350   IF LY>24 THEN LY=24
  362. 17360   LOCATE OLX,OLY:PRINT "     ";:CALLM 0,1,0,0,OLX*8,OLY*19,OLX*8+39,OLY*19+18,0:LOCATE LX,LY:PRINT CAS$;:CALLM 0,1,0,&HFF,LX*8,LY*19,LX*8+31,LY*19+18,3
  363. 17370 WEND:MOUSE 1,,,1:MOUSE 3,0,(SCM*4+4):MOUSE 3,1,(SCM*4+4):MOUSE 4,0,0,(639-SCM*320),(479-SCM*240)
  364. 17380 MRX0=MMX:MRY0=MMY:MRX1=MMX+MRX-1:MRY1=MMY+MRY-1
  365. 17390 IF MMODE=0 THEN M$="FRAME:"+CAS$+" は現在の位置に設定してよろしいですか?  [取 消]  [実 行]":GOSUB *ANSWER:CLS 4:LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:IF YN=0 THEN GOTO 17220
  366. 17400 MOUSE(4) OFF:CAST%(CAS,FRA,0)=MRX0:CAST%(CAS,FRA,1)=MRY0:CAST%(CAS,FRA,2)=MRX1:CAST%(CAS,FRA,3)=MRY1:RETURN
  367. 17410 *ANIMETEST
  368. 17420 MRX0=MMX:MRY0=MMY:MRX1=MMX+MRX-1:MRY1=MMY+MRY-1:LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:GOSUB *CSCREENOFF
  369. 17430 GET@A (CAST%(CAS,SFRA,0),CAST%(CAS,SFRA,1))-(CAST%(CAS,SFRA,2),CAST%(CAS,SFRA,3)),G&:GET@A (MRX0,MRY0)-(MRX1,MRY1),G2&
  370. 17440 WHILE MOUSE(6,1)=0
  371. 17450   PUT@A (MRX0,MRY0)-(MRX1,MRY1),G&:FOR A=0 TO 50:NEXT
  372. 17460   PUT@A (MRX0,MRY0)-(MRX1,MRY1),G2&:FOR A=0 TO 50:NEXT
  373. 17470 WEND
  374. 17480 LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:GOSUB *GSCREENON
  375. 17490 RETURN
  376. 17500 *GETDATASIZE
  377. 17510 IF SCM=1 THEN 17530
  378. 17520   CASTS&(CAS,1)=((MRX+7)\8)*4*MRY:RETURN
  379. 17530   CASTS&(CAS,1)=MRX*2*MRY:RETURN
  380. 20000 *NEWCAST
  381. 20010 COLOR 7:FOR A=0 TO 12:LOCATE A*3+10,10:PRINT CHR$(A+65,58);:NEXT
  382. 20020 FOR A=13 TO 25:LOCATE (A-13)*3+10,12:PRINT CHR$(A+65,58);:NEXT
  383. 20030 PBX0=48:PBY0=120:PBX1=591:PBY1=359:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  384. 20050 FOR A=0 TO 12:LOCATE A*3+10,10:IF CASTS&(A,0)=0 THEN PRINT CHR$(A+65,58);
  385. 20060 NEXT:FOR A=13 TO 25:LOCATE (A-13)*3+10,12:IF CASTS&(A,0)=0 THEN PRINT CHR$(A+65,58);
  386. 20070 NEXT:LOCATE 10,7:COLOR 3:PRINT "新規作成するキャストを左クリックで選んでください。";
  387. 20080 COLOR 6:LOCATE 48,17:PRINT "取 消";:COLOR 7:GOSUB *GSCREENOFF
  388. 20100 GOSUB *MOUSEGETCSK:IF YN=1 THEN 20100
  389. 20110 IF (MMX>383 AND MMX<424 AND MMY>322 AND MMY<341) OR I$=CHR$(24) THEN CLS 3:GOSUB *GSCREENON:RETURN
  390. 20120 GOSUB *AREACHECK:IF ER=1 THEN 20100
  391. 20130 IF MMX<80 OR MMX>383 OR MMY<190 OR MMY>245 THEN 20100
  392. 20140 IF MMY>208 AND MMY<225 THEN 20100
  393. 20150 IF ((MMX-80) MOD 24)>15 THEN 20100
  394. 20160 CAS=SGN(MMY\216)*13+((MMX-80) \ 24)
  395. 20170 IF CASTS&(CAS,0)<>0 THEN 20100
  396. 20180 GOSUB *GSCREENON:CLS 3:M$="マウスをドラッグしてキャストの大きさを指定してください｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT:CLS 4
  397. 20190 GOSUB *GETSTEP:GOSUB *GETRECTANGLE:GOSUB *MENUWRITE:LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B
  398. 20200 M$="CAST:"+CHR$(CAS+65)+"は ("+STR$(MRX)+" ,"+STR$(MRY)+" )の大きさでよろしいですか?  [取 消]  [実 行]":GOSUB *ANSWER:CLS 3:IF YN=0 THEN LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:RETURN
  399. 20210 M$="CAST:"+CHR$(CAS+65)+"-0 は現在の位置に設定してよろしいですか?  [取 消]  [実 行]":GOSUB *ANSWER:IF YN=1 THEN 20240
  400. 20220 CLS 3:M$="キャスト設定枠をドラッグしてCAST:"+CHR$(CAS+65)+"-0の位置を設定してください｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT
  401. 20230 LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:FRA=0:GOSUB *DRAGRECTANGLE:GOSUB *MENUWRITE
  402. 20240 CAST%(CAS,0,0)=MRX0:CAST%(CAS,0,1)=MRY0:CAST%(CAS,0,2)=MRX1:CAST%(CAS,0,3)=MRY1:CASTS&(CAS,0)=1:GOSUB *GETDATASIZE:CASTS&(CAS,2)=MRX:CASTS&(CAS,3)=MRY
  403. 20250 LINE (MRX0,MRY0)-(MRX1,MRY1),XOR,7,B:CLS 3:RETURN
  404. 21000 *DELETECAST
  405. 21010 COLOR 7:FOR A=0 TO 12:LOCATE A*3+10,10:PRINT CHR$(A+65,58);:NEXT
  406. 21020 FOR A=13 TO 25:LOCATE (A-13)*3+10,12:PRINT CHR$(A+65,58);:NEXT
  407. 21030 PBX0=48:PBY0=120:PBX1=591:PBY1=359:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  408. 21050 FOR A=0 TO 12:LOCATE A*3+10,10:IF CASTS&(A,0)<>0 THEN PRINT CHR$(A+65,58);
  409. 21060 NEXT:FOR A=13 TO 25:LOCATE (A-13)*3+10,12:IF CASTS&(A,0)<>0 THEN PRINT CHR$(A+65,58);
  410. 21070 NEXT:LOCATE 10,7:COLOR 3:PRINT "削除するキャストを左クリックで選んでください。";
  411. 21080 COLOR 6:LOCATE 48,17:PRINT "取 消";:COLOR 7:GOSUB *GSCREENOFF
  412. 21100 GOSUB *MOUSEGETCSK:IF YN=1 THEN 20100
  413. 21110 IF (MMX>383 AND MMX<424 AND MMY>322 AND MMY<341) OR I$=CHR$(24) THEN CLS 3:GOSUB *GSCREENON:RETURN
  414. 21120 GOSUB *AREACHECK:IF ER=1 THEN 20100
  415. 21130 IF MMX<80 OR MMX>383 OR MMY<190 OR MMY>245 THEN 20100
  416. 21140 IF MMY>208 AND MMY<225 THEN 20100
  417. 21150 IF ((MMX-80) MOD 24)>15 THEN 20100
  418. 21160 CAS=SGN(MMY\216)*13+((MMX-80) \ 24)
  419. 21170 IF CASTS&(CAS,0)=0 THEN 20100
  420. 21180 M$="CAST:"+CHR$(CAS+65)+"を削除してよろしいですか?  [取 消]  [実 行]":GOSUB *ANSWER:CLS 3:GOSUB *GSCREENON:IF YN=0 THEN RETURN
  421. 21190 CASTS&(CAS,0)=0:RETURN
  422. 22000 *CASTXCHANGE
  423. 22010 PBX0=48:PBY0=120:PBX1=591:PBY1=359:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  424. 22020 GOSUB 22250
  425. 22030 LOCATE 10,7:COLOR 3:PRINT "入替えるキャストを左クリックで2つ選んで実行を押してください｡";:LOCATE 10,8:PRINT "終わった時点で戻るを押してください｡";
  426. 22040 COLOR 6:LOCATE 48,17:PRINT "実 行";:LOCATE 58,17:PRINT "戻 る";:COLOR 7:GOSUB *GSCREENOFF:CIF=0:CIC=100:CIC2=100
  427. 22050 GOSUB *MOUSEGETCSK:IF YN<>2 THEN 22050
  428. 22060 IF (MMX>383 AND MMX<424 AND MMY>322 AND MMY<341) THEN 22180
  429. 22070 IF (MMX>463 AND MMX<504 AND MMY>322 AND MMY<341) THEN CLS 3:GOSUB *GSCREENON:RETURN
  430. 22080 GOSUB *AREACHECK:IF ER=1 THEN 22050
  431. 22090 IF MMX<80 OR MMX>383 OR MMY<190 OR MMY>245 THEN 22050
  432. 22100 IF MMY>208 AND MMY<225 THEN 22050
  433. 22110 IF ((MMX-80) MOD 24)>15 THEN 22050
  434. 22120 CAS=SGN(MMY\216)*13+((MMX-80) \ 24)
  435. 22130 COLOR 4:LOCATE (CAS MOD 13)*3+10,10+((CAS \ 13)*2):PRINT CHR$(CAS+65,58);:COLOR 7
  436. 22140 IF CIF=0 THEN CIC=CAS:CIF=1:GOTO 22050
  437. 22150 IF CIC=CAS OR CIC2=CAS THEN 22050
  438. 22160 IF CIF=1 THEN CIC2=CAS:CIF=2:GOTO 22050
  439. 22170 IF CIF=2 THEN GOSUB 22300:LOCATE (CIC MOD 13)*3+10,10+((CIC \ 13)*2):PRINT CHR$(CIC+65,58);:CIC=CIC2:CIC2=CAS:GOTO 22050
  440. 22180 IF CIF<>2 THEN BEEP:GOTO 22050
  441. 22190 FOR A=0 TO 31
  442. 22200   FOR B=0 TO 3:SWAP CAST%(CIC,A,B),CAST%(CIC2,A,B):NEXT
  443. 22210 NEXT
  444. 22220 FOR A=0 TO 3:SWAP CASTS&(CIC,A),CASTS&(CIC2,A):NEXT
  445. 22230 GOSUB 22250:CIF=0:CIC=100:CIC2=100:GOTO 22050
  446. 22250 FOR A=0 TO 25:LOCATE (A MOD 13)*3+10,((A \ 13)*2)+10:IF CASTS&(A,0)=0 THEN COLOR 2 ELSE COLOR 7
  447. 22260 PRINT CHR$(A+65,58);:NEXT:RETURN
  448. 22300 IF CASTS&(CIC,0)=0 THEN COLOR 2 ELSE COLOR 7
  449. 22310 RETURN
  450. 23000 *PRINTCAST
  451. 23010 FOR A=0 TO 25:LOCATE (A MOD 13)*3+10,((A \ 13)*2)+10:PRINT CHR$(A+65,58);:NEXT
  452. 23020 PBX0=48:PBY0=120:PBX1=591:PBY1=359:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  453. 23030 FOR A=0 TO 25:LOCATE (A MOD 13)*3+10,((A \ 13)*2)+10:IF CASTS&(A,0)<>0 THEN PRINT CHR$(A+65,58);
  454. 23040 NEXT:LOCATE 10,7:COLOR 3:PRINT M$;:COLOR 7
  455. 23050 COLOR 6:LOCATE 48,17:PRINT M1$;:LOCATE 58,17:PRINT M2$;:COLOR 7:RETURN
  456. 23100 *GETCASTMENU
  457. 23110 CAST=1000:GOSUB *MOUSEGETCSK:IF YN<>2 THEN RETURN
  458. 23120 IF (MMX>383 AND MMX<424 AND MMY>322 AND MMY<341) THEN YN=0:RETURN
  459. 23130 IF (MMX>463 AND MMX<504 AND MMY>322 AND MMY<341) THEN YN=1:RETURN
  460. 23140 GOSUB *AREACHECK:IF ER=1 THEN 23110
  461. 23150 IF MMX<80 OR MMX>383 OR MMY<190 OR MMY>245 THEN 23110
  462. 23160 IF MMY>208 AND MMY<225 THEN 23110
  463. 23170 IF ((MMX-80) MOD 24)>15 THEN 23110
  464. 23180 CAS=SGN(MMY\216)*13+((MMX-80) \ 24)
  465. 23190 IF CASTS&(CAS,0)=0 THEN 23110
  466. 23200 RETURN
  467. 23300 *CLEARMSG
  468. 23310 LOCATE 0,24:PRINT STRING$(79," ");:CALLM 0,1,0,0,0,453,639,474,0:RETURN
  469. 23500 *GENFRAME
  470. 23510 M$="作成するフレームの所属キャストを左クリックで指定してください｡":M1$="取 消":M2$="":GOSUB *PRINTCAST:GOSUB *GSCREENOFF
  471. 23520 GOSUB *GETCASTMENU:IF YN=1 THEN 23520
  472. 23530 IF YN=0 THEN CLS 3:GOSUB *GSCREENON:RETURN
  473. 23540 IF CASTS&(CAS,0)=32 THEN M$="指定されたキャスト`"+CHR$(CAS+65)+"' は既に32のフレームが登録されています｡":GOSUB *ALART:GOSUB *MOUSEWAIT:GOSUB *CLEARMSG:GOSUB *PRINTCAST:GOTO 23520
  474. 23550 MRX=CASTS&(CAS,2):MRY=CASTS&(CAS,3):ON ERROR GOTO 23990:ERASE G&,G2&:DIM G&((CASTS&(CAS,1)+3)\4),G2&((CASTS&(CAS,1)+3)\4):ON ERROR GOTO 0
  475. 23560 FRA=CASTS&(CAS,0):SFRA=FRA-1:FOR A=0 TO 3:CAST%(CAS,FRA,A)=CAST%(CAS,SFRA,A):NEXT
  476. 23570 CLS 3:M$="枠をドラッグして新しいフレームの位置を設定して下さい｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT:GOSUB *GSCREENON:MMODE=0:GOSUB *NEWFRAME:GOSUB *MENUWRITE:CASTS&(CAS,0)=FRA+1
  477. 23580 M$="続けて次のフレームを作成しますか?     [終 了]  [実 行]":GOSUB *ANSWER:IF YN=1 THEN 23540
  478. 23590 CLS 3:RETURN
  479. 23990 M$="メモリが足りません｡ CAST:"+CHR$(65+CAS)+" を一度削除して､枠を小さくして下さい｡":GOSUB *ALART:GOSUB *MOUSEWAIT:YN=0:RESUME 23530
  480. 24000 *DELETEFRAME
  481. 24010 M$="削除するフレームの所属キャストを左クリックで指定してください｡":M1$="取 消":M2$="":GOSUB *PRINTCAST:GOSUB *GSCREENOFF
  482. 24020 GOSUB *GETCASTMENU:IF YN=1 THEN 24020
  483. 24030 CLS 3:IF YN=0 THEN CLS 3:GOSUB *GSCREENON:RETURN
  484. 24040 IF CASTS&(CAS,0)=1 THEN OM$=M$:M$="CAST`"+CHR$(CAS+65)+"' は1つのフレームから構成されます｡削除にはキャスト削除を使用して下さい｡":GOSUB *ALART:GOSUB *MOUSEWAIT:GOSUB *CLEARMSG:M$=OM$:GOSUB *PRINTCAST:GOTO 24020
  485. 24050 MRX=CASTS&(CAS,2):MRY=CASTS&(CAS,3)
  486. 24060 GOSUB *FRAMELOCATE
  487. 24070 M$="削除するフレームを左クリックで指定して下さい｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT:GOSUB *CLEARMSG:GOSUB *CSCREENOFF
  488. 24080 WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND
  489. 24090 MMX=MOUSE(0):MMY=MOUSE(1):FRA=1000
  490. 24100 FOR A=0 TO CASTS&(CAS,0)-1
  491. 24110   IF (CAST%(CAS,A,0)<=MMX) AND (MMX<=CAST%(CAS,A,2)) AND (CAST%(CAS,A,1)<=MMY) AND (MMY<=CAST%(CAS,A,3)) THEN FRA=A:A=1000
  492. 24120 NEXT
  493. 24130 IF FRA=1000 THEN 24080
  494. 24140 GOSUB *FRAMELOCATE:LINE (CAST%(CAS,FRA,0),CAST%(CAS,FRA,1))-(CAST%(CAS,FRA,2),CAST%(CAS,FRA,3)),XOR,5,BF:GOSUB *GSCREENON
  495. 24150 M$="このフレームを削除してよろしいですか?     [取 消]  [実 行]":GOSUB *ANSWER:LINE (CAST%(CAS,FRA,0),CAST%(CAS,FRA,1))-(CAST%(CAS,FRA,2),CAST%(CAS,FRA,3)),XOR,5,BF:GOSUB *CLEARMSG:IF YN=0 THEN 24220
  496. 24160 FOR A=0 TO 3:CAST%(CAS,32,A)=0:NEXT:CASTS&(CAS,0)=CASTS&(CAS,0)-1
  497. 24170 FOR A=FRA TO 31
  498. 24180   FOR B=0 TO 3
  499. 24190     CAST%(CAS,A,B)=CAST%(CAS,A+1,B)
  500. 24200   NEXT
  501. 24210 NEXT
  502. 24220 M$="続けてフレームの削除を続けますか?     [終 了]  [実 行]":GOSUB *ANSWER:GOSUB *CLEARMSG:IF YN=1 THEN 24060
  503. 24230 CLS 3:RETURN
  504. 24500 *FRAMELOCATE
  505. 24510 FOR A=0 TO CASTS&(CAS,0)-1
  506. 24520   LINE (CAST%(CAS,A,0),CAST%(CAS,A,1))-(CAST%(CAS,A,2),CAST%(CAS,A,3)),XOR,7,B
  507. 24530 NEXT
  508. 24540 RETURN
  509. 25000 *FRAMEOPERATION
  510. 25010 M$="操作するフレームの所属キャストを左クリックで指定してください｡":M1$="取 消":M2$="":GOSUB *PRINTCAST:GOSUB *GSCREENOFF
  511. 25020 GOSUB *GETCASTMENU:IF YN=1 THEN 25020
  512. 25030 CLS 3:IF YN=0 THEN GOSUB *GSCREENON:RETURN
  513. 25040 IF CASTS&(CAS,0)<2 THEN M$="指定されたキャスト `"+CHR$(65+CAS)+"'はフレームを2個以上設定されていません｡":GOSUB *ALART:GOSUB *MOUSEWAIT:GOSUB *GSCREENON:CLS 3:RETURN
  514. 25050 M$="入替えるフレームを左クリックで2つ選んで実行を押してください｡":OM$="終わった時点で戻るを押してください｡":M1$="実 行":M2$="戻 る":GOSUB *PRINTFRAME
  515. 25060 GOSUB *GSCREENOFF:CIF=0:CIC=100:CIC2=100
  516. 25070 GOSUB *MOUSEGETCSK:IF YN<>2 THEN 25070
  517. 25080 IF (MMX>383 AND MMX<424 AND MMY>322 AND MMY<341) THEN 25200
  518. 25090 IF (MMX>463 AND MMX<504 AND MMY>322 AND MMY<341) THEN CLS 3:GOSUB *GSCREENON:RETURN
  519. 25100 GOSUB *AREACHECK:IF ER=1 THEN 25070
  520. 25110 IF MMX<80 OR MMX>455 OR MMY<190 OR MMY>245 THEN 25070
  521. 25120 IF MMY>208 AND MMY<225 THEN 25070
  522. 25130 IF ((MMX-80) MOD 24)>15 THEN 25070
  523. 25140 FRA=SGN(MMY\216)*13+((MMX-80) \ 24):IF FRA=>CASTS&(CAS,0) THEN 25070
  524. 25150 COLOR 3:LOCATE (FRA MOD 16)*3+10,10+((FRA \ 16)*2):PRINT RIGHT$(STR$(FRA),2);:COLOR 7
  525. 25160 IF CIF=0 THEN CIC=FRA:CIF=1:GOTO 25070
  526. 25170 IF CIC=FRA OR CIC2=FRA THEN 25070
  527. 25180 IF CIF=1 THEN CIC2=FRA:CIF=2:GOTO 25070
  528. 25190 IF CIF=2 THEN COLOR 7:LOCATE (CIC MOD 16)*3+10,10+((CIC \ 16)*2):PRINT RIGHT$(STR$(CIC),2);:CIC=CIC2:CIC2=FRA:GOTO 25070
  529. 25200 IF CIF<>2 THEN BEEP:GOTO 25070
  530. 25210 FOR A=0 TO 3
  531. 25220   SWAP CAST%(CAS,CIC,A),CAST%(CAS,CIC2,A)
  532. 25230 NEXT
  533. 25240 GOSUB *PRINTFRAME:CIF=0:CIC=100:CIC2=100:GOTO 25070
  534. 25990 END
  535. 26000 *PRINTFRAME
  536. 26010 CLS 3:COLOR 7:FOR A=0 TO 31:LOCATE (A MOD 16)*3+10,((A \ 16)*2)+10:PRINT RIGHT$(STR$(A),2);:NEXT
  537. 26020 PBX0=48:PBY0=120:PBX1=591:PBY1=359:PAT1%=&H40:PAT2%=&H04:FC%=1:GOSUB *PATBOX
  538. 26030 FOR A=0 TO CASTS&(CAS,0)-1:LOCATE (A MOD 16)*3+10,((A \ 16)*2)+10:PRINT RIGHT$(STR$(A),2);:NEXT
  539. 26040 LOCATE 10,7:COLOR 3:PRINT M$;:LOCATE 10,8:PRINT OM$;:COLOR 7
  540. 26050 COLOR 6:LOCATE 48,17:PRINT M1$;:LOCATE 58,17:PRINT M2$;:COLOR 7:RETURN
  541. 26500 *ENDBOX
  542. 26510 CLS 4:LOCATE 0,ML*24:PRINT " 終 了 ";:CALLM 0,1,0,&HFF,0,ML*456,55,ML*456+18,3:RETURN
  543. 27000 *FRAMEEDIT
  544. 27010 M$="操作するフレームの所属キャストを左クリックで指定してください｡":M1$="取 消":M2$="":GOSUB *PRINTCAST:GOSUB *GSCREENOFF
  545. 27020 GOSUB *GETCASTMENU:IF YN=1 THEN 27020
  546. 27030 CLS 3:GOSUB *GSCREENON:IF YN=0 THEN RETURN
  547. 27040 GOSUB *FRAMELOCATE:M$="操作するフレームをドラッグして下さい｡終了をクリックすると終了します｡":GOSUB *MESSAGE:GOSUB *MOUSEWAIT:CLS 4:ML=0:GOSUB *ENDBOX:MRX=CAST%(CAS,0,2)-CAST%(CAS,0,0)+1:MRY=CAST%(CAS,0,3)-CAST%(CAS,0,1)+1
  548. 27050 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1)
  549. 27060 FRA=1000:IF 55>MMX AND ML*456<MMY AND ML*456+18>MMY THEN CLS 4:GOSUB *MENUWRITE:WHILE MOUSE(6,0)=0:WEND:GOSUB *FRAMELOCATE:RETURN
  550. 27070 FOR A=0 TO CASTS&(CAS,0)-1
  551. 27080   IF (CAST%(CAS,A,0)<=MMX) AND (MMX<=CAST%(CAS,A,2)) AND (CAST%(CAS,A,1)<=MMY) AND (MMY<=CAST%(CAS,A,3)) THEN FRA=A:A=1000
  552. 27090 NEXT
  553. 27100 IF FRA=1000 THEN 27050
  554. 27110 MMODE=1:GOSUB *NEWFRAME:GOSUB *ENDBOX:GOSUB *CLEARMSG:GOTO 27050
  555. 30000 'mm%(11,0:アイテム数 1:メニューの表示位置 2:最長アイテム文字数)            cast%(cast,frame No.-1,0:x0 1:y0 2:x1 3:y1)                                casts&(cast,0:定義キャスト数[0なら未定義] 1:DataSize 2:Xdot数 3:Ydot数)
  556. 39000 *PMGFALART
  557. 39010 GOSUB *MOUSEINIT:GOSUB *ALART:GOSUB *MOUSEWAIT:RETURN
  558. 39500 *PMGFLOAD:MASK=1:MPC=15:X1=0:Y1=0
  559. 40000 *PMGF
  560. 40010 VERN=1:MOUSE 5
  561. 40040 A=ASC(INPUT$(1,1)):IF A<>VERN THEN M$="指定のPMGfファイルは未サポートのバージョンです｡":GOSUB *PMGFALART:ON ERROR GOTO 0:GOTO 2150
  562. 40050 X=CVI(INPUT$(2,1)):Y=CVI(INPUT$(2,1)):BIT=ASC(INPUT$(1,1)):PALM=ASC(INPUT$(1,1)):MASKM=ASC(INPUT$(1,1)):DUM$=INPUT$(2,1):BITL=ASC(INPUT$(1,1)):DUM$=INPUT$(1,1):HEL&=16
  563. 40060 IF BIT=1 OR BIT=4 THEN SCM=0 ELSE IF BIT=16 THEN SCM=1 ELSE M$="指定のPMGfファイルは256色ファイルです｡":GOSUB *PMGFALART:ON ERROR GOTO 0:GOTO 2150
  564. 40070 GOSUB *SCREEN_MODE:GOSUB *PALETTE_CHANGEP:MHEL&=HEL&
  565. 40080 IF (MASKM AND 128)=128 THEN MLLN&=CVL(INPUT$(4,1)):HEL&=HEL&+MLLN&+16
  566. 40090 CLOSE #1:GOSUB *GET_FILE:FAD&=VARPTR(FB%(0))+HEL&
  567. 40100 X2=X1+X-1:Y2=Y1+Y-1:IF (MASK AND MASKM AND 1)=0 THEN *MASK_CHK
  568. 40110 A=0:IF BIT=1 THEN GOSUB *MONO:GOTO *MASK_CHK ELSE GOSUB *MAIN:GOTO *MASK_CHK
  569. 40120 *MAIN:FOR C=Y1 TO Y2
  570. 40130  NPT=0:NG=0:NB2=0:AD&=VARPTR(G%(0))
  571. 40140  DL&=CALLM(4096,A,LLN,FAD&,VARPTR(BUF%(0,0)),VARPTR(GM%(0)),BITL)
  572. 40150  FAD&=FAD&+DL&
  573. 40160  PUT@A (X1,C)-(X2,C),GM%
  574. 40170  A=A+1:IF A>7 THEN A=0
  575. 40180 NEXT:RETURN
  576. 40190 *MONO
  577. 40200 FOR C=Y1 TO Y2
  578. 40210  NPT=0:NG=0:NB2=0:AD&=VARPTR(G%(0))
  579. 40220  DL&=CALLM(4096,A,LLN,FAD&,VARPTR(BUF%(0,0)),VARPTR(GM%(0)),BITL)
  580. 40230  FAD&=FAD&+DL&
  581. 40240  PUT@ (X1,C)-(X2,C),GM%,PSET,%MPC
  582. 40250  A=A+1:IF A>7 THEN A=0
  583. 40260 NEXT:RETURN
  584. 40270 *OBJE:FOR C=Y1 TO Y2
  585. 40280  NPT=0:NG=0:NB2=0:AD&=VARPTR(G%(0))
  586. 40290  DL&=CALLM(4096,A,LLN,FAD&,VARPTR(BUF%(0,0)),VARPTR(GM%(0)),BITL)
  587. 40300  FAD&=FAD&+DL&
  588. 40310  PUT@A (X1,C)-(X2,C),GM%,OR
  589. 40320  A=A+1:IF A>7 THEN A=0
  590. 40330 NEXT:RETURN
  591. 40340 *MASK_CHK
  592. 40350 IF (MASK AND MASKM AND 128)=0 THEN *ALL_END
  593. 40360 FAD&=VARPTR(FB%(0))+MHEL&+4:MOX=FNCV(FAD&):MOY=FNCV(FAD&+2):X=FNCV(FAD&+4):Y=FNCV(FAD&+6):MBITL=PEEK(FAD&+8):OBITL=PEEK(FAD&+9):FAD&=FAD&+12
  594. 40370 X1=MOX:X2=X1+X-1:Y1=MOY:Y2=Y1+Y-1:BITL=MBITL:OBIT=1:SWAP BIT,OBIT:LLN=(X+7)\8:MPC=0:A=0:GOSUB *MONO:SWAP BIT,OBIT:BITL=OBITL:GOSUB *CALC_LLN:A=0:GOSUB *OBJE
  595. 40380 *ALL_END:ERASE FB%:GOSUB *MOUSEINIT:FOR A=0 TO 25:FOR B=0 TO 3:CASTS&(A,B)=0:NEXT:FOR B=0 TO 31:FOR C=0 TO 3:CAST%(A,B,C)=0:NEXT:NEXT:NEXT:LINKF=0:LIF$="":FMF=0:CLS 4:GOSUB *GSCREENON:GOSUB *MENUWRITE:RETURN
  596. 40450 *SCREEN_MODE:IF SCM=1 THEN GOSUB *SCM1 ELSE GOSUB *SCM0
  597. 40460 MOUSE 5:IF BIT=1 THEN LLN=(X+7)\8:RETURN
  598. 40470 *CALC_LLN:IF BIT=4 THEN LLN=((X+7)\8)*4:RETURN
  599. 40480 IF BIT=8 THEN LLN=X:RETURN
  600. 40490 IF BIT=16 THEN LLN=X*2:RETURN
  601. 40500 *PALETTE_CHANGEP:IF PALM=0 THEN *PAL_INI ELSE GOSUB *PAL_GET:GOSUB *PALETTE_CHANGE:RETURN
  602. 40520 *PAL_GET:IF SCM=2 THEN 40540
  603. 40530 FOR A=0 TO 15:A$=INPUT$(1,1):B$=INPUT$(1,1):PAL&(A)=((ASC(A$)*65536)+(ASC(B$) AND &HF0)*16+(ASC(B$) AND 15))*16:NEXT:DL=15:HEL&=HEL&+(DL+1)*2:RETURN
  604. 40540 FOR A=0 TO 255:A$=CHR$(0)+INPUT$(3,1):PAL&(A)=CVL(A$):NEXT:DL=255:HEL&=HEL&+(DL+1)*3:RETURN
  605. 40550 *GET_FILE:F_F$=FILE$+".PGF":GOSUB *FILESIZEP:LOAD@ D$+FILE$+".PGF",FB%:RETURN
  606. 40560 *FILESIZEP
  607. 40570  F_D$=D$
  608. 40580  OPEN "R",#3,F_D$+"(1)"+F_F$
  609. 40590  F_SI&=LOF(3)
  610. 40600  CLOSE #3
  611. 40610 DIM FB%(CLNG(F_SI&/2+.5!)-2)
  612. 40620 RETURN
  613.